home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / exbine.zip / DEMO0A.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  9KB  |  283 lines
  1. { DEMO0.PAS Binary Editor 2.00A }
  2. {Copyright 1986,87 (c) Borland International }
  3. {Modified by Jeff Duntemann for Turbo Technix 8/31/87 }
  4.  
  5. program BinaryEditorDemo0;
  6.  
  7. uses
  8.   bined,
  9.   crt,
  10.   dos;        {JD}
  11.  
  12.   {***************************************************************}
  13.   {****************** demonstration follows **********************}
  14.   {***************************************************************}
  15.   {* This demonstration shows the use of one editor window which *}
  16.   {********* works just like a standalone Turbo editor. **********}
  17.   {***************************************************************}
  18.  
  19. const
  20.   {Coordinates of the editor window}
  21.   Windx1 = 1;
  22.   Windy1 = 1;
  23.   Windx2 = 80;
  24.   Windy2 = 25;                {Change to 43 for EGA 43-line operation}
  25.   MakeBackup = True;          {True to create .BAK files}
  26.  
  27. var
  28.   EdData : EdCB;              {Editor control block}
  29.   ExitCode : Word;            {Status code set by bin. ed. functions}
  30.   ExitCommand : Integer;      {Code for command used to leave editor}
  31.   Fname : string;             {Input name of file being edited}
  32.   Junk : Boolean;
  33.   XSave,YSave : Integer;      {JD}
  34.   VidSegment : Word;          {JD}
  35.   VideoBufferSize : Word;     {JD}
  36.   SavePtr  : ^Word;           {JD}
  37.   VideoPtr : ^Word;           {JD}
  38.   VideoSeg : Word;            {JD}
  39.   Now      : DateTime;        {JD}
  40.  
  41. const
  42.   {Commands other than ^K^D to exit editor}
  43.   ExitCommands : array[0..3] of Char =
  44.   (#2, ^K, ^Q, #0);
  45.  
  46.   {Procedures and functions used as part of the demo}
  47.  
  48.   procedure WriteStatus(msg : string);
  49.     {-Write a status message}
  50.  
  51.   begin                       {WriteStatus}
  52.     GoToXY(1, Windy2);
  53.     TextColor(White);
  54.     Write(msg);
  55.   end;                        {WriteStatus}
  56.  
  57.   procedure CheckInitBinary(ExitCode : Word);
  58.     {-Check the results of the editor load operation}
  59.  
  60.   begin                       {CheckInitBinary}
  61.     if ExitCode <> 0 then begin
  62.       {Couldn't load editor}
  63.       case ExitCode of
  64.         1 : WriteStatus('Insufficient heap space for text buffer');
  65.       else
  66.         WriteStatus('Unknown load error');
  67.       end;
  68.       GoToXY(1, Windy2);
  69.       Halt(1);
  70.     end;
  71.   end;                        {CheckInitBinary}
  72.  
  73.   procedure CheckReadFile(ExitCode : Word; Fname : string);
  74.     {-Check the results of the file read}
  75.   var
  76.     f : file;
  77.  
  78.   begin                       {CheckReadFile}
  79.     if ExitCode <> 0 then begin
  80.       {Couldn't read file}
  81.       case ExitCode of
  82.         1 : begin
  83.               {New file, assure valid file name}
  84.               {$I-}
  85.               Assign(f, Fname);
  86.               Rewrite(f);
  87.               if IOResult <> 0 then begin
  88.                 Close(f);
  89.                 WriteStatus('Illegal file name '+Fname);
  90.               end else begin
  91.                 Close(f);
  92.                 Erase(f);
  93.                 Write('New File');
  94.                 Delay(2000);
  95.                 Write(^M);
  96.                 ClrEol;
  97.                 GoToXY(1, 1);
  98.                 ClrEol;
  99.                 Exit;
  100.               end;
  101.               {$I+}
  102.             end;
  103.         2 : WriteStatus('Insufficient text buffer size');
  104.       else
  105.         WriteStatus('Unknown read error');
  106.       end;
  107.       GoToXY(1, Windy2);
  108.       Halt(1);
  109.     end;
  110.     GoToXY(1, 1);
  111.     ClrEol;
  112.   end;                        {CheckReadFile}
  113.  
  114.   procedure CheckSaveFile(ExitCode : Word; Fname : string);
  115.     {-Check the results of a file save}
  116.  
  117.   begin                       {CheckSaveFile}
  118.     if ExitCode <> 0 then begin
  119.       {Couldn't save file}
  120.       case ExitCode of
  121.         1 : WriteStatus('Unable to create output file '+Fname);
  122.         2 : WriteStatus('Error while writing output to '+Fname);
  123.         3 : WriteStatus('Unable to close output file '+Fname);
  124.       else
  125.         WriteStatus('Unknown write error');
  126.       end;
  127.       GoToXY(1, Windy2);
  128.       Halt(1);
  129.     end;
  130.   end;                        {CheckSaveFile}
  131.  
  132.   function GetFileName : string;
  133.     {-Return a file name either from the command line or a prompt}
  134.   var
  135.     Fname : string;
  136.  
  137.   begin                       {GetFileName}
  138.     if ParamCount > 0 then
  139.       Fname := ParamStr(1)
  140.     else begin
  141.       Write('Enter file name to edit: ');
  142.       ReadLn(Fname);
  143.     end;
  144.     if Fname = '' then
  145.       Halt;
  146.     GetFileName := Fname;
  147.   end;                        {GetFileName}
  148.  
  149.   function ExitBinaryEditor(var EdData      : EdCB;
  150.                                 ExitCommand : Integer) : Boolean;
  151.     {-Handle an editor exit - save or abandon file}
  152.   var
  153.     ExitCode : Word;
  154.  
  155.     function YesAnswer(prompt : string) : Boolean;
  156.       {-Return true for a yes answer to the prompt}
  157.     var
  158.       ch : Char;
  159.  
  160.     begin                     {YesAnswer}
  161.       WriteStatus(prompt);
  162.       repeat
  163.         ch := UpCase(readkey);
  164.       until ch in ['Y', 'N'];
  165.       Write(ch);
  166.       YesAnswer := (ch = 'Y');
  167.     end;                      {YesAnswer}
  168.  
  169.   begin                       {ExitBinaryEditor}
  170.     case ExitCommand of
  171.       -1 :                    {^K^D}
  172.         begin
  173.           ExitCode := SaveFileBinaryEditor(EdData, MakeBackup);
  174.           CheckSaveFile(ExitCode, FileNameBinaryEditor(EdData));
  175.           ExitBinaryEditor := True;
  176.           GoToXY(1, Windy2);
  177.         end;
  178.  
  179.       0 :                     {^K^Q}
  180.         begin
  181.           if ModifiedFileBinaryEditor(EdData) then
  182.             if YesAnswer('File modified. Save it? (Y/N) ') then begin
  183.               ExitCode := SaveFileBinaryEditor(EdData, MakeBackup);
  184.               CheckSaveFile(ExitCode, FileNameBinaryEditor(EdData));
  185.             end;
  186.           ExitBinaryEditor := True;
  187.           GoToXY(1, Windy2);
  188.         end;
  189.  
  190.     end;
  191.   end;                        {ExitBinaryEditor}
  192.  
  193. {$F+} { All User-Event procesudures must be FAR calls!}
  194. PROCEDURE Clocker(EventNo,Info : Integer);
  195.  
  196. VAR
  197.   Hours,Minutes,Seconds,Hundredths : Integer;
  198.   TimeBuf,TimeTemp : String;
  199.  
  200. BEGIN
  201.   GetTime(Hours,Minutes,Seconds,Hundredths);
  202.   Str(Hours:2,TimeBuf);
  203.   Str(Minutes:2,TimeTemp);
  204.   IF TimeTemp[1] = ' ' THEN TimeTemp[1] := '0';
  205.   TimeBuf := TimeBuf+':'+TimeTemp;
  206.   Str(Seconds:2,TimeTemp);
  207.   IF TimeTemp[1] = ' ' THEN TimeTemp[1] := '0';
  208.   TimeBuf := TimeBuf+':'+TimeTemp;
  209.   CRTPutFast(65,1,TimeBuf)
  210. END;
  211. {$F-}
  212.  
  213. {<<<< Monochrome >>>>}
  214. { From: COMPLETE TURBO PASCAL by Jeff Duntemann  }
  215. { Scott, Foresman & Co. 1986  ISBN 0-673-18600-8 }
  216. { Described in section 17.2 -- Last mod 2/1/86   }
  217. { HIGHLY specific to the IBM PC! }
  218.  
  219. FUNCTION Monochrome : Boolean;
  220.  
  221. VAR
  222.   Regs : Registers;
  223.  
  224. BEGIN
  225.   INTR(17,Regs);
  226.   IF (Regs.AX AND $0030) = $30 THEN Monochrome := True
  227.     ELSE Monochrome := False
  228. END;
  229.  
  230.  
  231. begin                         {Demo0}
  232.   XSave := WhereX; YSave := WhereY;                {JD}
  233.   VideoBufferSize := Windx2*Windy2*2;              {JD}
  234.   GetMem(SavePtr,VideoBufferSize);                 {JD}
  235.   IF Monochrome THEN VidSegment := $B000 ELSE      {JD}
  236.     VidSegment := $B800;                           {JD}
  237.   VideoPtr := Ptr(VidSegment,0);                   {JD}
  238.   Move(VideoPtr^,SavePtr^,VideoBufferSize);        {JD}
  239.  
  240.   {Get a file name}
  241.   Fname := GetFileName;
  242.  
  243.   {Initialize a window for the file}
  244.   ExitCode :=
  245.   InitBinaryEditor(
  246.   EdData,                     {Editor control block }
  247.   MaxFileSize,                {Size of data area to reserve for}
  248.                               {binary editor text buffer, $FFE0 max}
  249.   Windx1,                     {X of upper left corner; 1..80}
  250.   Windy1,                     {Y of upper left corner}
  251.   Windx2,                     {X of lower right corner}
  252.   Windy2,                     {Y of lower right corner}
  253.   True,                       {True = wait for retrace on CGA cards}
  254.   EdOptInsert+EdOptIndent,    {Initial editor toggles}
  255.   '.PAS',                     {Default extension for file names}
  256.   ExitCommands,               {Commands which will exit the editor}
  257.   Addr(Clocker));             {JD: Add a clock in the corner}
  258.   CheckInitBinary(ExitCode);
  259.  
  260.   {Read the file}
  261.   ExitCode := ReadFileBinaryEditor(EdData, Fname);
  262.   CheckReadFile(ExitCode, FileNameBinaryEditor(EdData));
  263.  
  264.   {Reset the editor for the new file}
  265.   ResetBinaryEditor(EdData);
  266.  
  267.   {Edit the file}
  268.   ExitCommand :=
  269.   UseBinaryEditor(
  270.   EdData,                     {Editor control block for this window}
  271.   '');                        {No startup commands passed to editor}
  272.  
  273.   {Handle the exit by saving the file or whatever}
  274.   Junk := ExitBinaryEditor(EdData, ExitCommand);
  275.  
  276.   {Release heap space used by the editor data structure}
  277.   ReleaseBinaryEditorHeap(EdData);
  278.  
  279.   Move(SavePtr^,VideoPtr^,VideoBufferSize);   {JD}
  280.   FreeMem(SavePtr,VideoBufferSize);           {JD}
  281.   GotoXY(XSave,YSave-1);                      {JD}
  282. end.                          {Demo0}
  283.